unit UntDBToExcel;

interface

uses
   DBClient, Variants;

type
  TDBToExcel = class(TObject)
  private
    procedure DataChange(ExcelApp: Variant; cdsdata: TClientDataSet);
  public
    procedure ToExcel(cdsdata: TClientDataSet);
  end;

implementation

uses
  MultiLang,ComObj,DB;

procedure TDBToExcel.DataChange(ExcelApp: Variant; cdsdata: TClientDataSet);
var lworkbook : Variant;
 lSheets :Variant;
 lExcelWorksheet :Variant;
 ColumnField : Variant;
 lline ,lcol:integer;
 iindex :integer;
begin
  lworkbook := ExcelApp.Workbooks.Add();
  lSheets := lworkbook.Sheets;
  lExcelWorksheet := lSheets.Add() ;
  lExcelWorksheet.Name :='dbToExcel';
  lline :=1;
  lcol :=1;
  for iindex := 0 to cdsdata.FieldCount - 1 do
  begin
    with cdsdata.Fields[iindex] do
    begin
      lExcelWorksheet.Cells[lline,lcol+iindex] :=FieldName;
      if DataType in [ftString,ftWideString] then
      begin
        ColumnField := lExcelWorksheet.Columns[lcol+iindex];
        ColumnField.Select;
        ExcelApp.Selection.NumberFormatLocal := '@';
      end
    end;
  end;
  with cdsdata do
  begin
    First;
    while not eof do
    begin
      Inc(lline);
      for iindex := 0 to cdsdata.FieldCount - 1 do
      begin
        lExcelWorksheet.Cells[lline,lcol+iindex] :=Fields[iindex].AsVariant;
      end;
      Next;
    end;
  end;
end;

procedure TDBToExcel.ToExcel(cdsdata: TClientDataSet);
var
  excelApp: Variant;
begin
  if not Assigned(cdsdata) then
  begin
    MulLang.MsgErrorInfo('Please Input ClientDataSet!');
    exit;
  end;
    excelApp := CreateOleObject( 'Excel.Application' );
  try
    DataChange(excelApp,cdsdata);
    ExcelApp.DisplayAlerts:=False;
    ExcelApp.save;
  finally
    ExcelApp.Quit;
  end;
end;

end.
